home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Src Code / TEEMONTH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  6.8 KB  |  218 lines
  1. {****************************************}
  2. {       TeeChart Charting Library        }
  3. { Copyright (c) 1996-98 by David Berneda }
  4. {          All Rights Reserved           }
  5. {****************************************}
  6. {$I teedefs.inc}
  7. unit TeeMonth;
  8.  
  9. interface
  10.  
  11. Uses Teengine,DB,
  12.      {$IFNDEF D3}
  13.      DBTables,
  14.      {$ENDIF}
  15.      TeeProcs;
  16.  
  17. { This unit fills a Series with points.
  18.  
  19.   The points are obtained calculating a COUNT 
  20.   or SUM of a Field in a Database Table or Query.
  21.  
  22.   The COUNT or SUM is performed BY MONTH or BY WEEK
  23.   over a DateTime field in the database.
  24.  
  25.   The parameters are as follows:
  26.  
  27.   ASeries          The Series to add the points.
  28.   ATable           The Database to scan.
  29.   DateFieldName    The name of the DateTime field in the table.
  30.   ValueFieldName   The name of the field in the table to SUM. (if Count = False)
  31.   DatePeriod       It can be:  dtOneMonth or dtOneWeek
  32.   Count            Is TRUE if we want to COUNT records. FALSE if we want to SUM.
  33.  
  34. }
  35. procedure DBMonthlySeries( ASeries:TChartSeries;
  36.                            ATable:TDataSet;
  37.                            Const DateFieldName,
  38.                                  ValueFieldName:String;
  39.                            DatePeriod:TDateTimeStep;
  40.                            Count:Boolean);
  41.  
  42. { Returns the number of the week, from 1 to 52.
  43.   It also returns the Year, which can be the same year, the
  44.   year before or the year after, depending on which day of the week
  45.   the year starts.
  46.   The "FirstDay" constant sets weeks to start at Monday.
  47. }
  48. Function DateToWeek(Const ADate:TDateTime; Var Year:Word):Integer;
  49.  
  50. Type
  51.   TFilterRecordProc=procedure (Sender:TDataSet; Var Accept:Boolean) of object;
  52.  
  53. procedure DBMonthlySeriesFilter( ASeries:TChartSeries;
  54.                                  ATable:TDataSet;
  55.                                  Const DateFieldName,
  56.                                        ValueFieldName:String;
  57.                                        DatePeriod:TDateTimeStep;
  58.                                        Count:Boolean;
  59.                                  FilterRecord:TFilterRecordProc);
  60.  
  61. implementation
  62.  
  63. Uses SysUtils,TeeProco,TeCanvas;
  64.  
  65. { returns the DateTime of the January 1st of the Year }
  66. function YearBegin(Const ADate:TDateTime):TDateTime;
  67. var Year,Month,Day:Word;
  68. begin
  69.   DecodeDate(ADate,Year,Month,Day);
  70.   result:=EncodeDate(Year,1,1);
  71. end;
  72.  
  73. { returns the Day number inside the Year }
  74. function YearDay(Const ADate:TDateTime):Longint;
  75. begin
  76.   result:=1+Trunc(ADate-YearBegin(ADate));
  77. end;
  78.  
  79. { returns the DateTime of December 31st of the Year }
  80. function YearEnd(Const ADate:TDateTime):TDateTime;
  81. var Year,Month,Day:Word;
  82. begin
  83.   DecodeDate(ADate,Year,Month,Day);
  84.   result:=EncodeDate(Year,12,31);
  85. end;
  86.  
  87. { Returns the number of the week, from 1 to 52.
  88.   It also returns the Year, which can be the same year, the
  89.   year before or the year after, depending on which day of the week
  90.   the year starts.
  91.   The "FirstDay" constant sets weeks to start at Monday.
  92. }
  93. Function DateToWeek(Const ADate:TDateTime; Var Year:Word):Integer;
  94. Const FirstDay=0; { Monday }
  95. Var d,m,y,j,j0,j1,week:Word;
  96. begin
  97.   DecodeDate(ADate,y,m,d);
  98.   If (m < 3) then
  99.     j := 1461*(y-1) DIV 4 + (153*(m+9)+2) DIV 5 + d
  100.   Else
  101.     j := 1461*y DIV 4 + (153*(m-3)+2) DIV 5 + d;
  102.  
  103.   j0:=1461*(y-1) DIV 4 + 310;
  104.   j0:=j0-(j0-firstday) MOD 7;
  105.  
  106.   If (j<j0) then
  107.   begin
  108.     j0 := 1461*(y-2) DIV 4 + 310;
  109.     j0 := j0 - (j0-firstday) MOD 7;
  110.     week := 1 + (j-j0) DIV 7;
  111.     year := y-1;
  112.   end
  113.   else
  114.   begin
  115.     j1 := 1461*y DIV 4 + 310;
  116.     j1 := j1 - (j1-firstday) MOD 7;
  117.     If j<j1 then
  118.     begin
  119.       week := 1 + (j-j0) DIV 7;
  120.       year := y;
  121.     end
  122.     Else
  123.     begin
  124.       week := 1;
  125.       year := y+1;
  126.     End;
  127.   End;
  128.   result:=week;
  129. End;
  130.  
  131. procedure DBMonthlySeriesFilter( ASeries:TChartSeries;
  132.                                  ATable:TDataSet;
  133.                                  Const DateFieldName,
  134.                                        ValueFieldName:String;
  135.                                        DatePeriod:TDateTimeStep;
  136.                                        Count:Boolean;
  137.                                  FilterRecord:TFilterRecordProc);
  138.  
  139. Var tmpXPos:TDateTime;
  140.     tmpWeek,
  141.     tmp:Integer;
  142.     Hour,Minute,Second,MSecond,Year,Month,Day:Word;
  143.     tmpQuantity:Double;
  144.     tmpLabel:String;
  145.     DateField:TDateTimeField;
  146.     ValueField:TFloatField;
  147.     tmpAccept:Boolean;
  148. begin
  149.   {$IFDEF TEETRIAL}
  150.   TeeTrial(ASeries.ComponentState);
  151.   {$ENDIF}
  152.   With ATable do
  153.   begin
  154.     DateField:=FieldByName(DateFieldName) as TDateTimeField;
  155.     if ValueFieldName='' then ValueField:=nil
  156.                          else ValueField:=FieldByName(ValueFieldName) as TFloatField;
  157.     ASeries.Clear;
  158.     DisableControls;
  159.     First;
  160.     While not eof do
  161.     begin
  162.       tmpAccept:=False;
  163.       if Assigned(FilterRecord) then
  164.          FilterRecord(ATable,tmpAccept)
  165.       else
  166.          tmpAccept:=True;
  167.       if tmpAccept then
  168.       begin
  169.         tmpXPos:=0;
  170.         tmpWeek:=0;
  171.         DecodeDate(DateField.Value,Year,Month,Day);
  172.         Case DatePeriod of
  173.           dtOneHour:  begin
  174.                         DecodeTime(DateField.Value,Hour,Minute,Second,MSecond);
  175.                         tmpXPos:=Round(DateField.Value)+Hour/24.0;
  176.                       end;
  177.           dtOneDay:   tmpXPos:=Round(DateField.Value);
  178.           dtOneMonth: tmpXPos:=EncodeDate(Year,Month,1);
  179.           dtOneWeek : begin
  180.                         tmpWeek:=DateToWeek(DateField.Value,Year);
  181.                         tmpXPos:=tmpWeek+Year*52;
  182.                       end;
  183.         end;
  184.         if Count then tmpQuantity:=1
  185.                  else tmpQuantity:=ValueField.Value;
  186.         tmp:=ASeries.XValues.Locate(tmpXPos);
  187.         if tmp=-1 then
  188.         begin
  189.           Case DatePeriod of
  190.             dtOneHour : tmpLabel:=FormatDateTime('dd hh:mm',tmpXPos);
  191.             dtOneDay  : tmpLabel:=FormatDateTime('dd/MMM',tmpXPos);
  192.             dtOneMonth: tmpLabel:=FormatDateTime('MMM/yy',tmpXPos);
  193.             dtOneWeek : tmpLabel:=IntToStr(tmpWeek)+'/'+IntToStr(Year);
  194.           end;
  195.           ASeries.AddXY(tmpXPos,tmpQuantity,tmpLabel{$IFNDEF D4},clTeeColor{$ENDIF});
  196.         end
  197.         else
  198.         With ASeries do YValues[tmp]:=YValues[tmp]+tmpQuantity;
  199.       end;
  200.       Next;
  201.     end;
  202.     EnableControls;
  203.   end;
  204. end;
  205.  
  206. { clears all points in ASeries and adds new points }
  207. procedure DBMonthlySeries( ASeries:TChartSeries;
  208.                            ATable:TDataSet;
  209.                            Const DateFieldName,
  210.                                  ValueFieldName:String;
  211.                            DatePeriod:TDateTimeStep;
  212.                            Count:Boolean);
  213. begin
  214.   DBMonthlySeriesFilter( ASeries,ATable,DateFieldName,ValueFieldName,DatePeriod,Count,nil);
  215. end;
  216.  
  217. end.
  218.